home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 5 / BBS in a Box -Volume V (BBS in a Box) (April 1992).iso / Files / Prog / M / MacOberon.cpt / MacOberonDoc.sit / OG2.Text (.txt) < prev    next >
Encoding:
Oberon Text  |  1990-11-07  |  47.9 KB  |  983 lines  |  [.Ob./.Ob*]
  1. Syntax16.Scn.Fnt
  2. Syntax12.Scn.Fnt
  3. Syntax12i.Scn.Fnt
  4. Syntax14.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax12b.Scn.Fnt
  7. Guide for Programmers of Commands
  8. In Oberon's modular hierarchy we recognize the following structural entities: The inner core, the outer core,
  9. the text system, the graphic system, the picture system, and a collection of tools.
  10. Oberon's module hierarchy
  11. Tool Packages                
  12.                    Net   Backup   Compiler   System   Miscellaneous  ColorSystem
  13.         Edit    Draw    Paint
  14.         Text System    Graphic System    Picture System
  15.         TextFrames    GraphicFrames    PictureFrames
  16.                                                                      Graphics    Pictures
  17.                             MenuViewers
  18.                                                         Outer Core    
  19.                  Inner Core         Printer             Oberon
  20.         Texts
  21.     Modules    Fonts    
  22.     Files
  23.     FileDir                            Math    MathL   Reals    Viewers
  24.      Drivers    Kernel              V24    SCC     Diskette     Input        Display
  25.                                                     
  26. The responsability of the inner core comprises memory management, file management, and program
  27. loading. The outer core additionally provides device drivers for network ports, keyboard, mouse, and display
  28. screens. Other parts of the outer core are viewer manager, elementary text management, and support for
  29. (remote) printing. Module Oberon represents the main interface between the outer core and its clients. It
  30. includes sections that are devoted to the current system configuration, to default strategies for track
  31. allocation and viewer placement, and to the support of command execution.
  32. Module Display stands at the bottom of the display system hierarchy. The display area is considered as a
  33. plane with x and y coordinates. It includes both a black-and-white area and a color area. Raster operations
  34. are used to generate and copy rectangular areas on the display plane. Sections of the plane can be made
  35. visible by display control procedures. The visible parts of the display plane are structured as tracks and
  36. viewers, and they are managed by the viewer manager Viewers. Module Oberon defines a standard layout
  37. featuring one user track and one system track per display screen. Finally, module MenuViewers is a
  38. high-level viewer manager for standard viewers consisting of a title bar and a rectangular main area
  39. surrounded by a thin frame. Both title bar and main area are so-called frames. While the title bar is almost
  40. always a text frame (see next paragraph), the type of the main frame depends on the kind of viewer.
  41. The text system, the graphic system, and the picture system are identical in structure. Each consists of a triple
  42. of linearly dependent modules. In the case of texts they are called Texts, TextFrames, and Edit. Texts defines
  43. the object type Text and exports intrinsic operations on texts. TextFrames defines the object type
  44. TextFrames.Frame and handles representations of texts within sub-frames of viewers. Edit provides
  45. additional (non-built-in) text-editing operations.
  46. Modules at the top (like Edit) are tool packages. Typically, a tool package merely exports a collection of
  47. commands in the form of parameterless procedures. Tool modules make intensive use of facilities provided
  48. by lower level modules, in particular by the viewer system, the text system, and the central system module
  49. Oberon. It is essential that usual commands strictly operate on texts or graphics instead of accessing
  50. keyboard or screen directly.
  51. We understand this chapter as a tutorial on implementing tool packages. First, we give a commented
  52. overview of the definitions of the most important lower-level modules. Then, we shall exemplify their
  53. usage by some typical excerpts from existing tools.
  54. The Display System
  55. DEFINITION Display; (*display driver*)
  56.   CONST black = 0; white = 15;
  57.     replace = 0; paint = 1; invert = 2; (*operation modes*)
  58.    TYPE
  59.     Frame = POINTER TO FrameDesc;
  60.     FrameMsg = RECORD END; (*base type of messages to frames*)
  61.     Pattern = LONGINT; (*pointer to pattern descriptor*)
  62.     (*PatternDesc = RECORD
  63.         w, h: SHORTINT;
  64.        raster: ARRAY (w + 7) DIV 8 * h OF BYTE
  65.        END*)
  66.     Font = POINTER TO Bytes;
  67.     Bytes = RECORD END;
  68.     Handler = PROCEDURE (Frame, VAR FrameMsg);
  69.     FrameDesc = RECORD (*base type of frames*)
  70.         dsc, next: Frame;
  71.          X, Y, W, H: INTEGER;
  72.         handle: Handler
  73.       END;
  74.     VAR
  75.      Unit: LONGINT; (*RasterUnit = Unit/36000 mm*)
  76.       Left,            (*left margin of black-and-white maps*)
  77.       ColLeft,       (*left margin of color maps*)
  78.       Bottom,      (*Bottom of primary map*)
  79.       UBottom,   (*Bottom of secondary map*)
  80.       Width,       (*map width*)
  81.       Height:       (*map height*)
  82.           INTEGER;
  83.      arrow, star, cross, downArrow, hook: Pattern;
  84.     PROCEDURE Map (X: INTEGER): LONGINT; (*address of map at X*)
  85.     PROCEDURE SetMode (X: INTEGER; s: SET);  (*set mode of map at X*)
  86.       (*black & white display: 0: display disable, 1: display secondary map, 2: inverse video*)
  87.   (*color display*)
  88.     PROCEDURE SetColor (col, red, green, blue: INTEGER); (*col < 0: overlay color*)
  89.     PROCEDURE GetColor (col: INTEGER; VAR red, green, blue: INTEGER);
  90.     PROCEDURE SetCursor(mode: SET);  (*color cursor; 0: crosshair, 1: arrow*)
  91.     PROCEDURE InitCC;  (*initialize color crosshair to full screen*)
  92.     PROCEDURE InitCP;  (*initialize color pattern to arrow shape*)
  93.     PROCEDURE DefCC (X, Y, W, H: INTEGER);  (*define window for color crosshair*)
  94.     PROCEDURE DefCP (VAR raster: ARRAY OF BYTE); (*define 64 x 64 raster for color pattern marker*)
  95.     PROCEDURE DrawCX (X, Y: INTEGER);  (*draw color cursor at X, Y*)
  96.     PROCEDURE FadeCX (X, Y: INTEGER);  (*fade color cursor at X, Y*)
  97.   (*fonts*)
  98.     PROCEDURE GetChar(f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: Pattern);
  99.       (*get box x, y, w, h, width dx, and raster data p of character ch in font f*)
  100.   (*raster operations*)
  101.     PROCEDURE CopyBlock (SX, SY, W, H, DX, DY, mode: INTEGER);
  102.       (*copy source block SX, SY, W, H to destination DX, DY using operation mode.
  103.       A block is given by its lower left corner X, Y and its dimension W, H*)
  104.     PROCEDURE CopyPattern (col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
  105.       (*copy pattern p in color col to X, Y using operation mode
  106.       col = 0: black; col = 15: white*)
  107.     PROCEDURE ReplPattern (col: INTEGER; pat: Pattern; X, Y, W, H, mode: INTEGER);
  108.       (*replicate pattern p in color col into block X, Y, W, H using operation mode,
  109.       proceeding from left to right and from bottom to top, starting at lower left corner*)
  110.     PROCEDURE ReplConst (col: INTEGER; X, Y, W, H, mode: INTEGER);
  111.       (*place "ones" in color col into block X, Y, W, H using operation mode*)
  112. END Display.
  113. Remarks:
  114. 1. The Ceres computer features a monochrome display whose position (lower left corner) is specified by the
  115. variables Left and Bottom, and whose width and height are given by the variables Width and Height. In fact,
  116. the drawing area is bigger; its y-coordinate ranges from -1248 to 799. Two sections can be made visible by
  117. the display control procedures, the first being characterized by {y| -1024 <= y < -224}, and the other by {y| 0
  118. <= y < 800}.
  119. 2. If a color display is installed, the module's raster procedures can be used to generate and copy areas on the
  120. color screen. The position of the color area (lower left corner) is specified by the variables ColLeft and
  121. Bottom; its width and height are the same as for the monochrome display.
  122. 3. The postulated preconditions upon procedure parameters are not checked by the module; this is left to
  123. the calling modules which are held responsible for robustness.
  124. 4. Notice that there are the following implementation restrictions of the raster operations:
  125. ReplConst
  126.   Color display: paint mode treated as replace mode. of this module
  127. ReplPattern
  128.    Pattern width w ignored and taken as 32 on monochrome and as 16 on color
  129.    display. 0 <= h < 256 on monochrome, 0 <= h <= 16 on color display.
  130.    Color display: x and x+w should be even, otherwise 1 is subtracted.
  131. CopyPattern
  132.    Replace mode treated like paint mode.
  133.     0 < w <= 32, 0 <= h < 256.
  134. CopyBlock
  135.    All modes treated as replace mode.
  136. ------------------------------------------------------------------------
  137. DEFINITION Viewers; (*viewer manager*)
  138.   IMPORT Display;
  139.   CONST
  140.     restore = 0; modify = 1; suspend = 2;
  141.       (*message ids referring to the following message type*)
  142.   TYPE
  143.       Message = RECORD (*message sent to viewers on viewer events*)
  144.           (Display.FrameMsg)
  145.           id: INTEGER;
  146.           X, Y, W, H: INTEGER;
  147.           state: INTEGER
  148.        END;
  149.     Viewer = POINTER TO ViewerDesc;
  150.     ViewerDesc = RECORD (*viewer descriptor extends Display.FrameDesc*)
  151.         (Display.FrameDesc)
  152.          state: INTEGER
  153.       END;
  154.     (*state > 1: displayed
  155.        state = 1: filler
  156.        state = 0: closed
  157.       state < 0: suspended*)
  158.   VAR curW, minH: INTEGER; (*current width of logical display, minimum viewer height*)
  159.   PROCEDURE InitTrack (W, H: INTEGER; Filler: Viewer);
  160.     (*append to current logical display and init track of width W and height H and install Filler*)
  161.   PROCEDURE OpenTrack (X, W: INTEGER; Filler: Viewer);
  162.     (*open new track overlaying span of [X, X + W[*)
  163.   PROCEDURE CloseTrack (X: INTEGER);
  164.     (*close track at X and restore overlaid tracks*)
  165.   PROCEDURE Locate (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);
  166.     (*in the track at X locate the following viewers:
  167.       filler fil,
  168.      bottom viewer bot,
  169.      an alternative viewer alt of height >= H,
  170.      viewer max of maximum height*)
  171.   PROCEDURE Open (V: Viewer; X, Y: INTEGER);
  172.     (*open new viewer V with top at Y in track at X*)
  173.   PROCEDURE Change (V: Viewer; Y: INTEGER);
  174.     (*expand or shrink viewer V to new top Y*)
  175.   PROCEDURE Close (V: Viewer);
  176.     (*remove viewer V from the display*)
  177.   PROCEDURE Recall (VAR V: Viewer);
  178.     (*recall most recently closed viewer*)
  179.   PROCEDURE This (X, Y: INTEGER): Viewer;
  180.     (*return viewer at X, Y*)
  181.   PROCEDURE Next (V: Viewer): Viewer;
  182.     (*return next upper neighbour of V*)
  183.   PROCEDURE Broadcast (VAR M: Display.FrameMsg);
  184.     (*send message M to all visible viewers*)
  185. END Viewers.
  186. --------------------------------------------------------------------------
  187. DEFINITION MenuViewers;
  188.   IMPORT Display, Viewers;
  189.   CONST extend = 0; reduce = 1; (*message ids*)
  190.   TYPE
  191.     Viewer = POINTER TO ViewerDesc;
  192.   ViewerDesc = RECORD (Viewers.ViewerDesc)
  193.       menuH: INTEGER (*height of menu frame*)
  194.     END;
  195.    ModifyMsg = RECORD (Display.FrameMsg)
  196.       id: INTEGER; (*extend or reduce*)
  197.       dY, Y, H: INTEGER (*translation vector dY; new Y and H*)
  198.     END;
  199.   VAR Ancestor: Viewer; (*current menu viewer*)
  200.   PROCEDURE Handle (V: Display.Frame; VAR M: Display.FrameMsg);
  201.       (*standard handler for menu viewers*)
  202.   PROCEDURE New (Menu, Main: Display.Frame; menuH, X, Y: INTEGER): Viewer; 
  203.         (*create and open at X, Y new menu viewer containing frames Menu and Main*)
  204. END MenuViewers.
  205. Remark:
  206. Messages to menu viewers not affexting size and position are passed on to their subframes. The ancestor
  207. viewer is made available to the subframe handlers via the variable Ancestor. MenuViewers also creates new
  208. messages of type ModifyMsg requesting subframes to change size or vertical position (or both). dY
  209. represents a vertical translation vector, and Y and H specify the new position and height respectively.
  210. --------------------------------------------------------------------------
  211. The Text System
  212. DEFINITION Fonts; (*font loader*)
  213.   IMPORT Display;
  214.   TYPE
  215.       Name = ARRAY 32 OF CHAR;
  216.       Font = POINTER TO FontDesc;
  217.       FontDesc = RECORD
  218.          name: Name; (*file name*)
  219.          height, minX, maxX, minY, maxY: INTEGER; (*characteristic data*)
  220.          raster: Display.Font (*raster data*)
  221.       END;
  222.      (*height = minimum distance between text lines,
  223.       minX, maxX, minY, maxY are minima and maxima of X and Y,
  224.       if all character boxes of the font are placed at the origin 0, 0*)
  225.   VAR Default: Font; (*the default font*)
  226.       PROCEDURE This (name: ARRAY OF CHAR): Font;
  227.       (*font with name given*)
  228. END Fonts.
  229. --------------------------------------------------------------------------
  230. DEFINITION Texts; (*text manager*)
  231.   IMPORT Files, Fonts;
  232.   CONST
  233.     (*symbol classes, see def. of type Scanner*)
  234.     Inval = 0;          (*invalid symbol*)
  235.     Name = 1;        (*name s (length len)*)
  236.     String = 2;        (*literal string s (length len)*)
  237.     Int = 3;             (*integer i (decimal or hexadecimal)*)
  238.     Real = 4;          (*real number x*)
  239.     LongReal = 5;  (*long real number y*)
  240.     Char = 6;          (*special character c*)
  241.     replace = 0; insert = 1; delete = 2; (*op-codes*)
  242.   TYPE
  243.     Text = POINTER TO TextDesc;
  244.     Notifier = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
  245.     TextDesc = RECORD
  246.       len: LONGINT; (*text length*)
  247.      notify: Notifier (*of editing operations*)
  248.     END;
  249.     Reader = RECORD
  250.       (Files.Rider)
  251.       eot: BOOLEAN;
  252.      fnt: Fonts.Font; (*font of current character*)
  253.      col: SHORTINT; (*color of current character*)
  254.       voff: SHORTINT (*vertical offset*)
  255.     END;
  256.     Scanner = RECORD
  257.       (Reader)
  258.       nextCh: CHAR;
  259.       line: INTEGER;
  260.       class: INTEGER;
  261.       i: LONGINT;
  262.       x: REAL;
  263.       y: LONGREAL;
  264.       c: CHAR;
  265.       len: SHORTINT;
  266.       s: ARRAY 32 OF CHAR
  267.     END;
  268.      (*used to convert a text into a stream of symbols.
  269.      Symbol classes are defined under CONST*) 
  270.     Buffer = POINTER TO BufDesc;
  271.     BufDesc = RECORD
  272.       len: LONGINT (*buffer length*)
  273.     END;
  274.     (*used to write a stream of textual data in a buffer*)
  275.     (*used to store a stretch of a text*)
  276.     Writer = RECORD
  277.       (Files.Rider)
  278.       buf: Buffer; (*associated buffer*)
  279.       fnt: Fonts.Font; (*current font*)
  280.       col: SHORTINT; (*color of current character*)
  281.       voff: SHORTINT (*vertical offset*)
  282.     END;
  283.   PROCEDURE Load (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
  284.     (*load text block from file f at position pos to text T*)
  285.   PROCEDURE Open (T: Text; name: ARRAY OF CHAR);
  286.     (*open text T from disk file specified by name; open new text if name = ""*)
  287.   PROCEDURE OpenBuf (B: Buffer);
  288.     (*open new text buffer B*)
  289.   PROCEDURE OpenReader (VAR R: Reader; T: Text; pos: LONGINT);
  290.     (*open text reader R and set it up at position pos in text T*)
  291.   PROCEDURE Read (VAR R: Reader; VAR ch: CHAR);
  292.     (*read next character in ch*)
  293.   PROCEDURE Pos (VAR R: Reader): LONGINT;
  294.     (*return reader's position within its text*)
  295.   PROCEDURE Store (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
  296.     (*store text T on disk file f at position pos*)
  297.   PROCEDURE Save (T: Text; beg, end: LONGINT; B: Buffer);
  298.     (*append stretch [beg, end[ of text T to buffer B*)
  299.   PROCEDURE Copy (SB, DB: Buffer);
  300.     (*append copy of source buffer SB to destination buffer DB*)
  301.   PROCEDURE ChangeLooks (T: Text; beg, end: LONGINT; sel: SET; fnt: Fonts.Font; col, voff: SHORTINT);
  302.     (*change character attributes within stretch [beg, end[ of text T. sel selects attributes to be changed.
  303.       0, 1, 2 IN sel = fnt, col, voff selected*)
  304.   PROCEDURE Insert (T: Text; pos: LONGINT; B: Buffer);
  305.     (*insert buffer B in text T at position pos*)
  306.   PROCEDURE Append (T: Text; B: Buffer);
  307.     (*append buffer B to text T*)
  308.   PROCEDURE Delete (T: Text; beg, end: LONGINT);
  309.     (*delete stretch [beg, end[ of text T*)
  310.   PROCEDURE Recall (VAR B: Buffer);
  311.     (*recall previously deleted text*)
  312.   PROCEDURE OpenScanner (VAR S: Scanner; T: Text; pos: LONGINT);
  313.     (*open text scanner S and set it up at position pos in text T*)
  314.   PROCEDURE Scan (VAR S: Scanner);
  315.     (*read next symbol*)
  316.   PROCEDURE OpenWriter (VAR W: Writer);
  317.     (*open new writer W*)
  318.   PROCEDURE SetFont (VAR W: Writer; fnt: Fonts.Font);
  319.     (*set writer W to font fnt*)
  320.   PROCEDURE SetColor (VAR W: Writer; col: SHORTINT);
  321.     (*set writer W to color col*)
  322.   PROCEDURE SetOffset (VAR W: Writer; voff: SHORTINT);
  323.     (*set writer W to vertical offset voff*)
  324.   PROCEDURE Write (VAR W: Writer; ch: CHAR);
  325.     (*write character ch to W's buffer*)
  326.   PROCEDURE WriteLn (VAR W: Writer);
  327.     (*write end-of-line to W's buffer*)
  328.   PROCEDURE WriteInt (VAR W: Writer; x, n: LONGINT);
  329.     (*write integer x to W's buffer. Right adjust to n positions*)
  330.   PROCEDURE WriteHex (VAR W: Writer; x: LONGINT);
  331.     (*write integer x to W's buffer in hexadecimal form.
  332.   PROCEDURE WriteString (VAR W: Writer; s: ARRAY OF CHAR);
  333.     (*write string s to W's buffer*)
  334.   PROCEDURE WriteReal (VAR W: Writer; x: REAL; n: INTEGER);
  335.     (*write real number x to W's buffer. Use n positions*)
  336.   PROCEDURE WriteRealFix (VAR W: Writer; x: REAL; n, k: INTEGER);
  337.     (*write real number x to W's buffer in fixed-point form,
  338.       using k positions for decimal fractions and n positions in total*)
  339.   PROCEDURE WriteRealHex (VAR W: Writer; x: REAL);
  340.     (*write real number x to W's buffer in hexadecimal form*)
  341.   PROCEDURE WriteLongReal (VAR W: Writer; x: LONGREAL; n: INTEGER);
  342.     (*write long real number x to W's buffer. Use n positions*)
  343.   PROCEDURE WriteLongRealHex (VAR W: Writer; x: LONGREAL);
  344.     (*write long real number x to W's buffer in hexadecimal form*)
  345. END Texts.
  346. Remark:
  347. Open does not create a text object nor does it install a notifier procedure. Both actions are left to the calling
  348. modules. Typically, a calling module first creates a text object (or an extension of it) by using NEW, and then
  349. installs a notifier procedure. The main purpose of notifier procedures is requesting the display to
  350. re-establish consistency after a change in a text has occurred.
  351. --------------------------------------------------------------------------
  352. DEFINITION TextFrames; (*text display*)
  353.   IMPORT Display, Texts;  
  354.   TYPE
  355.     Location = RECORD
  356.       org, pos: LONGINT; (*line origin, position*)
  357.       dx, x, y: INTEGER (*width and position of located character*)
  358.     END;
  359.     Frame = POINTER TO FrameDesc;
  360.     FrameDesc = RECORD
  361.       (Display.FrameDesc)
  362.       text: Texts.Text; (*displayed text*)
  363.       org: LONGINT; (*position in text of first displayed character*)
  364.       col: INTEGER; (*background color*)
  365.       lsp, asr, dsr: INTEGER; (*line spacing, ascender, descender*)
  366.       left, right, top, bot: INTEGER; (*margins*)
  367.       markH: INTEGER; (*margin width, position of mark*)
  368.       time: LONGINT; (*time of latest selection*)
  369.       mark, car, sel: INTEGER; (*state of mark, caret, selection*)
  370.       carloc: Location; (*caret location*)
  371.       selbeg, selend: Location (*locations of begin and end of selection*)
  372.     END;
  373.     (*mark < 0: arrow mark
  374.       mark = 0: no mark
  375.       mark > 0: position mark
  376.       car = 0: caret not set
  377.       car > 0: caret set
  378.       sel = 0: no selection active
  379.       sel > 0: selection active*)
  380.      UpdateMsg* = RECORD
  381.         (Display.FrameMsg)
  382.          id: INTEGER;
  383.         text: Texts.Text;
  384.         beg, end: LONGINT
  385.       END;
  386.     VAR menuH, barW, left, right, top, bot, asr, dsr, lsp: INTEGER; (*standard sizes*)
  387.       PROCEDURE Restore (F: Frame);
  388.         (restore frame F*)
  389.      PROCEDURE Suspend(F: Frame);
  390.         (*suspend frame F*)
  391.      PROCEDURE Extend (F: Frame; newY: INTEGER);
  392.       (*extend frame F to bottom newY*)
  393.     PROCEDURE Reduce (F: Frame; newY: INTEGER);
  394.       (*reduce frame F to bottom newY*)
  395.     PROCEDURE Mark (F: Frame; mark: INTEGER);
  396.       (*mark frame F as specified by mark*)
  397.     PROCEDURE Show (F: Frame; pos: LONGINT);
  398.       (*show text part containing position pos in frame F*)
  399.     PROCEDURE Pos (F: Frame; X, Y: INTEGER): LONGINT;
  400.       (*convert coordinates X, Y to text position*)
  401.     PROCEDURE SetCaret (F: Frame; pos: LONGINT);
  402.       (*set caret in frame F at position pos*)
  403.     PROCEDURE TrackCaret (F: Frame; X, Y: INTEGER; VAR keysum: SET);
  404.       (*track caret in frame F, starting from X, Y, and return mouse-keys pressed*)
  405.     PROCEDURE RemoveCaret (F: Frame);
  406.       (*remove caret from frame F*)
  407.     PROCEDURE SetSelection (F: Frame; beg, end: LONGINT);
  408.       (*select text stretch [beg, end[ in F*)
  409.     PROCEDURE TrackSelection (F: Frame; X, Y: INTEGER; VAR keysum: SET);
  410.       (*track selection in frame F, starting from X, Y, and return mouse-keys pressed*)
  411.     PROCEDURE RemoveSelection (F: Frame);
  412.       (*remove selection from frame F*)
  413.     PROCEDURE TrackLine (F: Frame; X, Y: INTEGER; VAR org: LONGINT; VAR keysum: SET);
  414.       (*track text line in frame F, starting from X, Y, and return line-origin and mouse-keys pressed*)
  415.     PROCEDURE TrackWord (F: Frame; X, Y: INTEGER; VAR pos: LONGINT; VAR keysums: SET);
  416.       (*track text word in frame F, starting from X, Y,
  417.      and return starting position and mouse-keys pressed*)
  418.     PROCEDURE Replace (F: Frame; beg, end: LONGINT);
  419.       (*text stretch [beg, end[ was replaced; update frame F*)
  420.     PROCEDURE Insert (F: Frame; beg, end: LONGINT);
  421.       (*text stretch [beg, end[ was inserted; update frame F*)
  422.     PROCEDURE Delete (F: Frame; beg, end: LONGINT);
  423.       (*text stretch [beg, end[ was deleted; update frame F*)
  424.    (*---------------- message handling ----------------*)    
  425.     PROCEDURE NotifyDisplay (T: Texts.Text; op: INTEGER; beg, end: LONGINT);
  426.       (*notify display manager of text status change*)    
  427.     PROCEDURE Call* (F: Frame; pos: LONGINT; new: BOOLEAN);
  428.      (*call command specified at pos in frame F. new forces loading of newest version*)    
  429.     PROCEDURE Write* (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
  430.      (*write character ch with given attributes at caret position*)    
  431.     PROCEDURE Defocus* (F: Frame); (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
  432.       (*remove caret*)    
  433.     PROCEDURE Neutralize* (F: Frame);
  434.       (*remove marks*)    
  435.     PROCEDURE Modify* (F: Frame; id, dY, Y, H: INTEGER);
  436.      (*vertically translate and extend or reduce frame F. id indicates type (extension or reduction),
  437.        dy is a translation vector, and Y, H specify new location and height respectively*)    
  438.     PROCEDURE Open* (
  439.         F: Frame; H: Display.Handler; T: Texts.Text; org: LONGINT;
  440.         col, left, right, top, bot, asr, dsr, lsp: INTEGER);
  441.       (*open new text frame F displaying text T starting from position org, with background color col,
  442.        margins left, right, top, bot, and line geometry asr, dsr, lsp = ascender, descender line spacing.
  443.            Install notifier H*)    
  444.     PROCEDURE Copy* (F: Frame; VAR F1: Frame);
  445.       (*generate copy F1 of frame F. Initialize to empty frame*)    
  446.     PROCEDURE CopyOver* (F: Frame; text: Texts.Text; beg, end: LONGINT);
  447.       (*copy over text stretch [beg, end[ to caret position in frame F*)    
  448.     PROCEDURE GetSelection* (F: Frame; VAR text: Texts.Text; VAR beg, end, time: LONGINT);
  449.       (*get current text selection in frame F (if any)*)    
  450.     PROCEDURE Update* (F: Frame; VAR M: UpdateMsg);
  451.       (*update display after editing operation*)    
  452.     PROCEDURE Edit* (F: Frame; X, Y: INTEGER; Keys: SET);
  453.       (*track mouse and interpret editing commands*)    
  454.     PROCEDURE Handle* (F: Display.Frame; VAR M: Display.FrameMsg);
  455.       (*standard handler for text frames*)    
  456.     PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text;
  457.       (*create new displayed text from named file. Empty file name means empty text*)    
  458.     PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame;
  459.       (*create new menu frame containing listed commands*)    
  460.     PROCEDURE NewText* (text: Texts.Text; pos: LONGINT): Frame;
  461.       (*create new standard text frame*)    
  462. END TextFrames.
  463. --------------------------------------------------------------------------
  464. The Oberon Core
  465. DEFINITION Math; (*math library for reals*)
  466.   CONST pi = 3.14159265; e = 2.71828182;
  467.   PROCEDURE sqrt(x: REAL): REAL;
  468.   PROCEDURE exp(x: REAL): REAL;
  469.   PROCEDURE ln(x: REAL): REAL;
  470.   PROCEDURE sin(x: REAL): REAL;
  471.   PROCEDURE cos(x: REAL): REAL;
  472.   PROCEDURE arctan(x: REAL): REAL;
  473. END Math.
  474. --------------------------------------------------------------------------
  475. DEFINITION MathL; (*math library for longreals*)
  476.     CONST pi = 3.141592653589793D0;
  477.       e = 2.718281828459045D0;
  478.   PROCEDURE sqrt(x: LONGREAL): LONGREAL;
  479.   PROCEDURE exp(x: LONGREAL): LONGREAL;
  480.   PROCEDURE ln(x: LONGREAL): LONGREAL;
  481.   PROCEDURE sin(x: LONGREAL): LONGREAL;
  482.   PROCEDURE cos(x: LONGREAL): LONGREAL;
  483.   PROCEDURE arctan(x: LONGREAL): LONGREAL;
  484. END MathL.
  485. --------------------------------------------------------------------------
  486. DEFINITION Files; (*file manager*)
  487.   TYPE Handle = RECORD END ;
  488.        File   = POINTER TO Handle;
  489.      (*A file is a sequence of bytes, accessed via (a pointer to) a  handle. Files are stored on disk and
  490.        may be referenced through a name entered in the file directory*)
  491.        Rider  = RECORD
  492.                   res: INTEGER;
  493.                   eof: BOOLEAN;
  494.                   file: File
  495.                 END ;
  496.     (*Elements  of files are accessed through a rider, which has a position that is advanced when
  497.       reading or writing data. The position is an integer between 0 and the length of the file to which
  498.       the rider is attached. The fields eof and res serve as result parameters of file procedures.*)
  499.   PROCEDURE Old(name: ARRAY OF CHAR): File;
  500.     (*the file with the given name. NIL if the name is not in the directory*)
  501.   PROCEDURE New(name: ARRAY OF CHAR): File;
  502.     (*a new file with given name*)
  503.   PROCEDURE Register(f: File);
  504.     (*Close file f and register it under its name in the directory.
  505.       If the name exists already, the corresponding old file is unregistered*)  
  506.   PROCEDURE Close(f: File);  
  507.   PROCEDURE Purge(f: File);
  508.   PROCEDURE Length(f: File): LONGINT;  (*the number of bytes in the file*)
  509.   PROCEDURE Set(VAR r: Rider; f: File; pos: LONGINT);
  510.     (*Associate rider r with file f at position pos. r.eof := FALSE*)
  511.   PROCEDURE Read(VAR r: Rider; VAR x: BYTE);
  512.     (*read byte and advance rider by one position. If at end, r.eof := TRUE and x := 0X*)
  513.   PROCEDURE ReadBytes(VAR r: Rider; VAR x: ARRAY OF BYTE; n: INTEGER);
  514.     (*read n bytes and advance rider by n positions.
  515.       If at end, r.eof := TRUE and r.res := no. of bytes requested but not read.*)
  516.   PROCEDURE Write(VAR r: Rider; x: BYTE);
  517.     (*write byte and advance rider by one position*)
  518.   PROCEDURE WriteBytes(VAR r: Rider; VAR x: ARRAY OF BYTE; n: INTEGER);
  519.     (*write n bytes and advance rider by n positions*)
  520.   PROCEDURE Pos(VAR r: Rider): LONGINT;
  521.   PROCEDURE Base(VAR r: Rider): File;
  522.   PROCEDURE Rename(old, new: ARRAY OF CHAR; VAR res: INTEGER);
  523.     (*res = 0: renamed;  res = 1: new name existed already and now denotes the renamed file;
  524.         res = 2: old name not in directory;  res = 3: name is illegal;  res = 4: name is too long *)
  525.   PROCEDURE Delete(name: ARRAY OF CHAR; VAR res: INTEGER);
  526.     (*res = 0: deleted;  res = 2: name not in directory;
  527.         res = 3: name is illegal;  res = 4: name is too long *)
  528. END Files.
  529. --------------------------------------------------------------------------
  530. DEFINITION Diskette; (*diskette manager*)
  531.   TYPE EntryHandler* = PROCEDURE (name: ARRAY OF CHAR; date, time: INTEGER; size: LONGINT);
  532.   VAR res: INTEGER; (*result of file-oriented operation, error occurred = (res # 0)*)
  533.        err: SHORTINT; sect: LONGINT; busy: BOOLEAN; (*state of device driver*)
  534.   (*device driver*)
  535.   PROCEDURE Reset;
  536.   PROCEDURE GetSector (sec: INTEGER; VAR buf: ARRAY OF BYTE; off: INTEGER);
  537.   PROCEDURE PutSector (sec: INTEGER; VAR buf: ARRAY OF BYTE; off: INTEGER);
  538.   PROCEDURE Format;
  539.   (*directory handler*)
  540.   PROCEDURE InitDir (format: CHAR); (*format for future extension*)
  541.   PROCEDURE ReadDir;
  542.   PROCEDURE WriteDir;
  543.   PROCEDURE GetData (VAR date, time, nofFiles, nofClusters: INTEGER); (*get volume data*)
  544.   PROCEDURE Enumerate (proc: EntryHandler);
  545.   (*file handler*)
  546.   PROCEDURE ReadAll;
  547.   PROCEDURE ReadFile (name: ARRAY OF CHAR);
  548.   PROCEDURE WriteFile (name: ARRAY OF CHAR);
  549.   PROCEDURE DeleteFile (name: ARRAY OF CHAR);
  550. END Diskette.
  551. --------------------------------------------------------------------------
  552. DEFINITION Input; (*keyboard and mouse driver*)
  553.   PROCEDURE Available(): INTEGER;
  554.     (*the number of characters available from the keyboard*)
  555.   PROCEDURE Read (VAR ch: CHAR);
  556.     (*next character from keyboard*)
  557.   PROCEDURE Mouse (VAR keys: SET; VAR x, y: INTEGER);
  558.     (*current coordinates and key setting of mouse.
  559.       0 IN keys = right key pressed
  560.       1 IN keys = middle key pressed
  561.       2 IN keys = left key pressed*)
  562.   PROCEDURE SetMouseLimits (w, h: INTEGER); 
  563.     (* define width and height of rectangle in which mouse moves*)
  564.   PROCEDURE Time(): LONGINT;
  565.     (* current system time in units of 1/300 sec*)
  566. END Input.
  567. --------------------------------------------------------------------------
  568. DEFINITION SCC; (*SCC driver*)
  569.   (*Serial Communications Controller driver module (Zilog Z8530)
  570.     Data are transmitted in blocks. Each block contains two parts: header and data *)
  571.   TYPE Header =
  572.     RECORD valid: BOOLEAN; dadr, sadr, typ: SHORTINT;
  573.       len: INTEGER; (*of data following header*)
  574.       destLink, srcLink: INTEGER  (*link numbers*)
  575.     END ;
  576.   (*dadr is the receiver's machine number, len is the length (number of bytes) of
  577.     the data part. typ, destLink, and srcLink are not interpreted by SCC*)
  578.   PROCEDURE Start(filter: BOOLEAN);
  579.     (*initialise the SCC*)
  580.   PROCEDURE Send(VAR head, buf: ARRAY OF BYTE);
  581.     (*send buf[0] ... buf[head.len-1] to head.adr*)
  582.   PROCEDURE Available(): INTEGER;
  583.     (*number of bytes available from receiver buffer. Buffer contains stream of
  584.       received bytes, including headers and data parts*)
  585.   PROCEDURE ReceiveHead(VAR head: ARRAY OF BYTE);
  586.     (*read a header from the receiver buffer*)
  587.   PROCEDURE Receive(VAR x: BYTE);
  588.     (*read a byte from the receiver buffer*)
  589.   PROCEDURE Skip(m: INTEGER);
  590.     (*skip m bytes in the receiver buffer*)
  591.   PROCEDURE Stop;  (*turn SCC off*)
  592. END SCC.
  593. --------------------------------------------------------------------------
  594. DEFINITION V24; (*V24 driver*)
  595.     (*interrupt-driven UART channel B*)
  596.     PROCEDURE Start(CSR, MR2: CHAR);
  597.     (* Clock Select Register:
  598.              66X: 1200 bps
  599.              88X: 2400 bps
  600.             0BBX: 9600 bps
  601.         Mode Register 2:
  602.              7X: 1 stop bit
  603.             0FX: 2 stop bits *)
  604.     PROCEDURE SetOP(s: SET); (*output port*)
  605.     PROCEDURE ClearOP(s: SET);
  606.     (* 0: DTR,  1: RTS *)
  607.              PROCEDURE IP(n: INTEGER): BOOLEAN; (*input port*)
  608.     PROCEDURE SR(n: INTEGER): BOOLEAN;
  609.     (*Status Register. 0: Rx rdy, 2: Tx rdy, 4: overrun*)
  610.     PROCEDURE Available(): INTEGER;
  611.     PROCEDURE Receive(VAR x: BYTE);
  612.     PROCEDURE Send(x: BYTE);
  613.     PROCEDURE Break;
  614.     PROCEDURE Stop;
  615. END V24.
  616. --------------------------------------------------------------------------
  617. DEFINITION Printer; (*printer interface*)
  618.     VAR res: INTEGER; (*result*)
  619.    PROCEDURE Open(VAR name, user: ARRAY OF CHAR; password: LONGINT);
  620.     (*res = 0: opened, 1: no printer, 2: no link, 3: bad response, 4: no permission*)
  621.       PROCEDURE Font (fno: SHORTINT; VAR name: ARRAY OF CHAR); (*install font*)
  622.       PROCEDURE String (x, y: INTEGER; VAR s: ARRAY OF CHAR; fno: SHORTINT); (*place string*)
  623.       PROCEDURE ContString (VAR s: ARRAY OF CHAR; fno: SHORTINT); (*place continuation string*)
  624.       PROCEDURE Line (x, y, w, h: INTEGER); (*place horizontal or vertical line*)
  625.       PROCEDURE XLine (x, y, dx, dy: INTEGER); (*place line of general direction*)
  626.       PROCEDURE Circle (x, y, a, b: INTEGER); (*place circle or ellipsis*)
  627.       PROCEDURE Shade (x, y, w, h, col: INTEGER); (*shade area*)
  628.       PROCEDURE Picture (x, y, w, h, mode: INTEGER; adr: LONGINT); (*place picture*)
  629.       PROCEDURE Page(nofcopies: INTEGER); (*print current page*)
  630.    PROCEDURE Close; (*close connection*)
  631. END Printer.
  632. --------------------------------------------------------------------------
  633. DEFINITION Oberon; (*system manager*)
  634.   IMPORT Display, Viewers, Texts;
  635.   CONST
  636.     consume = 0; track = 1; (*ids for input messages*)
  637.     defocus = 0; neutralize = 1; mark = 2; (*ids for control messages*)
  638.   TYPE
  639.     Painter = PROCEDURE (x, y: INTEGER);
  640.     Marker = RECORD Fade, Draw: Painter END;
  641.     Cursor = RECORD
  642.        on: BOOLEAN; m: Marker; X, Y: INTEGER
  643.     END;
  644.    ParList = POINTER TO ParRec;
  645.    ParRec = RECORD
  646.       vwr: Viewers.Viewer; (*caller's viewer*)
  647.       frame: Display.Frame; (*caller's sub-frame*)
  648.       text: Texts.Text; (*parameter list*)
  649.       pos: LONGINT (*starting position of parameter list*)
  650.    END;
  651.     InputMsg = RECORD
  652.       (Display.FrameMsg)
  653.       id: INTEGER; (*message id*)
  654.       modes, keys: SET; (*current modes and mouse keys*)
  655.       X, Y: INTEGER; (*current location of the mouse*)
  656.       ch: CHAR (*current char*)
  657.     END;
  658.     ControlMsg = RECORD
  659.       (Display.FrameMsg)
  660.       id: INTEGER; (*message id*)
  661.       X, Y: INTEGER (*current location of the mous*)
  662.      END;
  663.     SelectionMsg = RECORD
  664.       (Display.FrameMsg)
  665.       time: LONGINT;
  666.       text: Texts.Text;
  667.       beg, end: LONGINT
  668.     END;
  669.      CopyOverMsg* = RECORD
  670.       (Display.FrameMsg)
  671.       text*: Texts.Text;
  672.       beg*, end*: LONGINT
  673.     END;
  674.     CopyMsg* = RECORD
  675.       (Display.FrameMsg)
  676.       F*: Display.Frame
  677.     END;
  678.    Task = POINTER TO TaskDesc; (*installable task*)
  679.     Handler = PROCEDURE;
  680.     TaskDesc = RECORD
  681.       safe: BOOLEAN; (*safe tasks are not removed after trap*)
  682.       handle: Handler
  683.     END;
  684.   VAR
  685.   (*configuration*)
  686.     FocusViewer: Viewers.Viewer; (*current focus viewer*)
  687.     Log: Texts.Text; (*system log text*)
  688.     Par: ParList; (*actual parameters for next command*)
  689.     User: ARRAY 8 OF CHAR; Password: LONGINT; (*current user*)
  690.     CurFnt, CurCol:, CurOff SHORTINT; (*current font, color, vertical offset*)
  691.      Arrow, Star: Marker;
  692.      Mouse, Pointer: Cursor;
  693.   (*user identification*)
  694.    PROCEDURE SetUser (VAR user, password: ARRAY OF CHAR);
  695.   (*clocks*)
  696.     PROCEDURE GetClock (VAR t, d: LONGINT);
  697.     PROCEDURE SetClock (t, d: LONGINT);
  698.     PROCEDURE Time (): LONGINT; (*in units of 1/300 sec*)
  699.   (*cursor handling*)
  700.     PROCEDURE OpenCursor (VAR c: Cursor);
  701.     PROCEDURE FadeCursor (VAR c: Cursor);
  702.     PROCEDURE DrawCursor (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);
  703.    (*display management*)
  704.     PROCEDURE OpenDisplay (UW, SW, H: INTEGER);
  705.         (*initialize new display with user track width UW, system track width SW, and height H*)
  706.     PROCEDURE DisplayWidth (X: INTEGER): INTEGER;
  707.         (*get width of display at X*)
  708.     PROCEDURE DisplayHeight (X: INTEGER): INTEGER;
  709.         (*get height of display at X*)
  710.      PROCEDURE OpenTrack (X, W: INTEGER);
  711.         (*open a new track of width W at X*)
  712.      PROCEDURE UserTrack (X: INTEGER): INTEGER;
  713.         (*get left margin of user track at X*)
  714.      PROCEDURE SystemTrack (X: INTEGER): INTEGER;
  715.         (*get left margin of system track at X*)
  716.      PROCEDURE AllocateUserViewer (DX: INTEGER; VAR X, Y: INTEGER);
  717.         (*allocate new user viewer within display at DX*)
  718.      PROCEDURE AllocateSystemViewer (DX: INTEGER; VAR X, Y: INTEGER);
  719.         (*allocate new system viewer within display at DX*)
  720.     PROCEDURE PassFocus (V: Viewers.Viewer);
  721.         (*pass focus to viewer V*)
  722.       PROCEDURE RemoveMarks (X, Y, W, H: INTEGER);
  723.         (*remove marks within given rectangle*)
  724.     PROCEDURE MarkedViewer (): Viewers.Viewer;
  725.         (*returns viewer marked by star-shaped pointer*)
  726.   (*command interpretation*)
  727.      PROCEDURE ShowMenu (VAR cmd: INTEGER; X, Y: INTEGER; menu: ARRAY OF CHAR);
  728.        (* menu = {command "|"} command.
  729.            Six commands allowed, 6 > cmd >= -1.
  730.            cmd  = 5:  first command selected
  731.            cmd = 0:  last command selected
  732.            cmd = -1:  no selection *)
  733.       PROCEDURE Call (VAR name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);
  734.         (*call command name and pass parameter list par. Option new requests loading of module.
  735.             Done = (res = 0)*)
  736.       PROCEDURE GetSelection (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
  737.       (*get most recent text selection. Text selection exists = (time >= 0)*)
  738.         PROCEDURE Install (T: Task);
  739.          (*install new task T*)
  740.       PROCEDURE Remove (T: Task);
  741.         (*remove installed task T*)
  742.       PROCEDURE Collect;
  743.         (*demand garbage collector*)
  744.       PROCEDURE SetFont* (fnt: Fonts.Font);
  745.         (*set current font*)
  746.       PROCEDURE SetColor* (col: SHORTINT);
  747.         (*set current color*)
  748.       PROCEDURE SetOffset* (voff: SHORTINT);
  749.         (*set current vertical offset*)
  750. END Oberon.
  751. Remark;
  752. Installed tasks are considered to be background activities. They are activated by the central loop when no
  753. input events have been detected. For example, the garbage collector is implemented as an installed task.
  754. Notice that installed tasks may be invalidated after their host module has been unloaded (or replaced).
  755. Unsafe tasks are automatically removed after a system trap in order to avoid an infinite repetition of the
  756. same error.
  757. --------------------------------------------------------------------------
  758. Tutorial Examples
  759. Write time stamp to system log
  760.   PROCEDURE TimeStamp;
  761.   BEGIN
  762.     Texts.WriteString(W, "TimeStamp "); Texts.WriteInt(W, Oberon.Time(), 1); Texts.WriteLn(W);
  763.     Texts.Append(Oberon.Log, W.buf)
  764.   END TimeStamp;
  765. where
  766.   VAR W: Texts.Writer;
  767. is globally defined initialized by Texts.OpenWriter(W).
  768. Remarks:
  769. 1. Normally, one (global) writer per module is sufficient.
  770. 2. If you desire a specific part of the output text to appear in a new font, for example in italics variant
  771. Syntax10i.Scn.Fnt, call Texts.SetFont(W,Fonts.This("Syntax10i.Scn.Fnt")) before writing this part and
  772. Texts.SetFont(W,Fonts.Default) before continuing to write ordinary text. 
  773. Process selected text
  774.   PROCEDURE CountWords;
  775.     VAR T: Texts.Text; R: Texts.Reader;
  776.       beg, end, pos, time: LONGINT; words: INTEGER; ch: CHAR;
  777.   BEGIN words := 0;
  778.    Oberon.GetSelection(T, beg, end, time); (*get most recent selection*)
  779.     IF time >= 0 THEN (*if it exists*)
  780.       Texts.OpenReader(R, T, beg); pos := beg; (*setup reader and initialize pos*)
  781.       Texts.Read(R, ch); INC(pos); (*read next character*)
  782.       IF (pos # end) & (ch > " ") THEN
  783.          REPEAT Texts.Read(R, ch); INC(pos) UNTIL (pos = end) OR (ch <= " ");
  784.          INC(words)
  785.       END;
  786.       WHILE pos # end DO
  787.           (*(pos # end) & (ch <= " ")*)
  788.           REPEAT Texts.Read(R, ch); INC(pos) UNTIL (pos = end) OR (ch > " ");
  789.           IF pos # end THEN
  790.             REPEAT Texts.Read(R, ch); INC(pos) UNTIL (pos = end) OR (ch <= " ");
  791.             INC(words)
  792.           END
  793.        END
  794.     END;
  795.     Texts.WriteString(W, "WordCount = "); Texts.WriteInt(W, words, 1); Texts.WriteLn(W);
  796.     Texts.Append(Oberon.Log, W.buf) (*append to system log*)
  797.   END CountWords;
  798. where again
  799.   VAR W: Texts.Writer;
  800. is globally defined and initialized by Texts.OpenWriter(W).
  801. Open a viewer in system track, generate, and display text data
  802.   PROCEDURE Directory;
  803.      VAR Menu, Main: TextFrames.Frame; T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER;
  804.   BEGIN
  805.      T := TextFrames.Text(""); (*generate new (and empty) text to be displayed in a frame*)
  806.      Menu := TextFrames.NewMenu("Directory", StandardMenu); (*generate standard menu frame*)
  807.      Main := TextFrames.NewText(T, 0); (*generate standard text frame*)
  808.      Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  809.      V := MenuViewers.New(Menu, Main, TextFrames.menuH, X, Y); (*open standard menu viewer*)
  810.      TextFrames.Mark(Main, -1); (*setup vertical arrow mark*)
  811.      Diskette.Enumerate(Lister); (*pass over Lister-procedure to enumerator*)
  812.      Texts.Append(T, W.buf); (*append writer to T and display written text*)
  813.      TextFrames.Mark(Main, 1) (*restore position mark*)
  814.   END Directory;
  815. where
  816.   CONST StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store";
  817.    VAR T: Texts.Text; W: Texts.Writer;
  818. are globally defined, W is globally initialized by Texts.OpenWriter(W), and Lister is an (upcalled) procedure
  819. displaying directory entries:
  820.   PROCEDURE* Lister (name: ARRAY OF CHAR; date, time: INTEGER; size: LONGINT);
  821.   BEGIN
  822.     Texts.WriteString(W, name);
  823.     Texts.Write(W, " "); Texts.WriteInt(W, size, 1);
  824.     Texts.Write(W, " "); Texts.WriteDate(W, time, date);
  825.     Texts.WriteLn(W)
  826.   END Lister;
  827. Remarks:
  828. 1. The above program generates its whole output text before displaying it. Alternatively, if you move the
  829. statement Texts.Append(T, W.buf) into the Lister-procedure, every generated directory entry is displayed
  830. immediately.
  831. 2. Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y) is a standard proposal for the placing of  a new
  832. system viewer within the track from which the command was called. Of course, individual algorithms are
  833. possible as well. For example, if the new viewer is desired to cover the bottom most viewer, except if the
  834. pointer overrides this, the algorithm is
  835.   PROCEDURE AllocateSystemViewer (DX: INTEGER; VAR X, Y: INTEGER);
  836.     VAR bot: Viewers.Viewer;
  837.   BEGIN
  838.     IF Oberon.Pointer.on THEN X := Oberon.Pointer.X; Y := Oberon.Pointer.Y
  839.     ELSE bot := Viewers.This(Oberon.SystemTrack(DX), 0); X := bot.X; Y := bot.H - Viewers.minH
  840.     END
  841.   END AllocateSystemViewer;
  842. 3. TextFrames.NewText generates a standard text frame. The following statement sequence produce a text
  843. frame with an individual handler and a customized geometry.
  844.    NEW(F); Open(F, Handle, text, pos, col, left, right, top, bot, asr, dsr, lsp);
  845. where F is of type TextFrames.Frame.
  846. Open a viewer in user track and display existing text
  847.   PROCEDURE OpenText;
  848.     VAR par: Oberon.ParList; Text: TextFrames.Frame; S: Texts.Scanner;
  849.     V: Viewers.Viewer; X, Y: INTEGER;
  850.   BEGIN
  851.     par := Oberon.Par; (*access parameters*)
  852.     Text := par.frame(TextFrames.Frame); (*calling frame*)
  853.     TextFrames.Mark(Text, -1); (*arrow mark*)
  854.     Texts.OpenScanner(S, par.text, par.pos); (*open scanner at position of parameter list*)
  855.     Texts.Scan(S); (*get symbol*)
  856.     IF S.class = Texts.Name THEN
  857.       Oberon.AllocateUserViewer(par.vwr.X, X, Y);
  858.       V := MenuViewers.New(
  859.          TextFrames.NewMenu(S.s, StandardMenu);
  860.          TextFrames.NewText(TextFrames.Text(S.s), 0);
  861.          TextFrames.menuH, X, Y);
  862.     END;
  863.     TextFrames.Mark(Text, 1) (*restore position mark*)
  864.   END OpenText;
  865. Remark:
  866. Oberon.AllocateUserViewer(par.vwr.X, X, Y) is a standard proposal for the placing of a new viewer in the
  867. caller's user track. Again, individual algorithms are possible as well.
  868. Grow viewer
  869.    PROCEDURE Grow;
  870.      VAR V, newV: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg; DH: INTEGER;
  871.    BEGIN
  872.      V := Oberon.Par.vwr; (*get originator viewer*)
  873.      DH := Oberon.DisplayHeight(V.X); (*get height of this track*)
  874.      IF V.H < Oberon.DisplayHeight(V.X) THEN (*if viewer is small*)
  875.        Oberon.OpenTrack(V.X, V.W); (*open overlaying track*)
  876.        V.handle(V, M); newV := M.F(Viewers.Viewer); (*get a copy of the viewer*)
  877.        Viewers.Open(newV, V.X, DH); (*open new big viewer*)
  878.        N.id := Viewers.restore; newV.handle(newV, N) (*ask new viewer to draw itself*)
  879.      END
  880.    END Grow;
  881.  Remark:
  882. The Grow command is generic in the sense that it can handle viewer instances of any (current or future)
  883. class. Typically (and unavoidably) generic commands use message passing instead of ordinary procedure
  884. calls. This object-oriented style will be explained in more detail in the next chapter. Also notice that actually a
  885. copy of the original viewer is opened in the new track. When this track is being closed later, the original
  886. viewer will reappear.
  887. Process viewer text or sequence of texts, depending on context
  888.   PROCEDURE ProcessText;
  889.     VAR par: Oberon.ParList; Main: TextFrames.Frame; S: Texts.Scanner; T: Texts.Text;
  890.   BEGIN
  891.     par := Oberon.Par; (*access parameters*)
  892.     IF par.frame = par.vwr.dsc THEN (*command in menu frame*)
  893.       IF par.vwr.dsc.next IS TextFrames.Frame THEN
  894.         Main := par.vwr.dsc.next(TextFrames.Frame); (*main text frame*)
  895.         TextFrames.Mark(Main, -1) (*set arrow mark*)
  896.         Process(Main.text); (*process displayed text*)
  897.         TextFrames.Mark(Main, 1) (*restore position mark*)
  898.       END
  899.     ELSE (*command in main text frame*)
  900.       Main := par.frame(TextFrames.Frame);
  901.       TextFrames.Mark(Main, -1) (*set arrow mark*)
  902.       Texts.OpenScanner(S, par.text, par.pos); (*open scanner at position of parameter list*)
  903.       Texts.Scan(S); (*get first symbol*)
  904.       WHILE S.class = Texts.Name DO
  905.         Texts.Open(T, S.s); (*open text from file*)
  906.         Process(T); (*process this text*)
  907.         Texts.Scan(S) (*get next symbol*)
  908.        END;
  909.        TextFrames.Mark(Main, 1) (*restore position mark*)
  910.      END
  911.   END ProcessText;
  912. Delete selected part of text in marked viewer
  913.   PROCEDURE Delete;
  914.     VAR Main: TextFrames.Frame; V: Viewers.Viewer;
  915.   BEGIN
  916.     V := Oberon.MarkedViewer(); (*get marked viewer*)
  917.     Main := V.dsc.next(TextFrames.Frame); (*main text frame of marked viewer*)
  918.     IF Main.sel > 0 THEN (*if there exists a selection*)
  919.       Texts.Delete(Main.text, Main.selbeg.pos, Main.selend.pos) (*delete text*)
  920.     END
  921.   END Delete;
  922. Copy most recently selected text part to caret's position
  923.   PROCEDURE CopyText;
  924.     VAR Main: TextFrames.Frame; buf: Texts.Buffer; V: Viewers.Viewer; time: LONGINT;
  925.   BEGIN
  926.     Oberon.GetSelection(T, beg, end, time); (*get most recent selection*)
  927.     IF time >= 0 THEN (*if it exists*)
  928.       Texts.OpenBuffer(buf);
  929.       Texts.Save(T, beg, end, buf); (*save text in buffer*)
  930.       V := Oberon.FocusViewer; (*get focus viewer*)
  931.       IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN (*if text viewer*)
  932.         Main := V.dsc.next(TextFrames.Frame); (*main text frame*)
  933.         IF Main.car > 0 THEN (*if caret set*)
  934.           Texts.Insert(Main.text, Main.carloc.pos, buf) (*insert text at caret's position*)
  935.         END
  936.       END
  937.     END
  938.   END CopyText;
  939. Copy font from visibly marked position to text selection
  940.   PROCEDURE CopyFont;
  941.     VAR F: TextFrames.Frame; T: Texts.Text; R: Texts.Reader; V: Viewers.Viewer;
  942.       beg, end, time: LONGINT; X, Y: INTEGER; ch: CHAR;
  943.   BEGIN
  944.     Oberon.GetSelection(T, beg, end, time); (*get most recent selection*)
  945.     IF (time >= 0) & Oberon.Pointer.on THEN (*if found and pointer visible*)
  946.       X := Oberons.Pointer.X; Y := Oberon.Pointer.Y;
  947.       V := Viewers.This(X, Y); (*marked viewer*)
  948.       IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
  949.         F := V.dsc.next(TextFrames.Frame);
  950.         IF (X >= F.X) & (X < F.X + F.W) & (Y >= F.Y) & (Y < F.Y + F.H) THEN
  951.           Texts.OpenReader(R, F.text, TextFrames.Pos(F, X, Y)); (*position reader*)
  952.           Texts.Read(R, ch); (*read marked char*)
  953.           Texts.ChangeLooks(T, beg, end, {0}, R.fnt, 0, 0) (*change font alone*)
  954.         END
  955.       END
  956.     END
  957.   END CopyFont;
  958. Move caret to next character written in italics
  959.   PROCEDURE SearchItalics;
  960.     VAR Main: TextFrames.Frame; R: Texts.Reader; italic: Fonts.Font; V: Viewers.Viewer;
  961.       pos: LONGINT; ch: CHAR;
  962.   BEGIN
  963.     italic := Fonts.This("Syntax10i.Scn.Fnt");
  964.     V := Oberon.FocusViewer; (*get focus viewer*)
  965.     IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN (*if text viewer*)
  966.       Main := V.dsc.next(TextFrames.Frame); (*main text frame*)
  967.       IF Main.car > 0 THEN (*if caret set*)
  968.         Texts.OpenReader(R, Main.text, Main.carloc.pos); (*open reader at caret's position*)
  969.         Texts.Read(R, ch);
  970.         WHILE ~R.eot & (R.fnt # italic) DO Texts.Read(R, ch) END; (*read char stream*)
  971.         IF ~R.eot THEN (*not end of text*)
  972.           pos := Texts.Pos(R); (*reader's position*)
  973.           TextFrames.RemoveSelection(Main); (*remove all marks*)
  974.           TextFrames.RemoveCaret(Main);
  975.           Oberon.RemoveMarks(Main.X, Main.Y, Main.W, Main.H);
  976.           TextFrames.Show(Main, Max(0, pos - 200)); (*show text at pos*)
  977.           TextFrames.SetCaret(Main, pos) (*set caret to new position*)
  978.         END
  979.       END
  980.     END
  981.   END SearchItalics;
  982. where Max is the maximum-function.
  983.